home *** CD-ROM | disk | FTP | other *** search
/ PC Open 93 / PC Open 93 CD 1.bin / internet / AmphetaDesk / lib / XML / Simple.pm
Encoding:
Perl POD Document  |  2002-06-11  |  52.9 KB  |  1,930 lines
  1. # $Id: Simple.pm,v 1.2 2002/06/12 03:35:49 morbus Exp $
  2.  
  3. package XML::Simple;
  4.  
  5. =head1 NAME
  6.  
  7. XML::Simple - Easy API to read/write XML (esp config files)
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.     use XML::Simple;
  12.  
  13.     my $ref = XMLin([<xml file or string>] [, <options>]);
  14.  
  15.     my $xml = XMLout($hashref [, <options>]);
  16.  
  17. Or the object oriented way:
  18.  
  19.     require XML::Simple;
  20.  
  21.     my $xs = new XML::Simple(options);
  22.  
  23.     my $ref = $xs->XMLin([<xml file or string>] [, <options>]);
  24.  
  25.     my $xml = $xs->XMLout($hashref [, <options>]);
  26.  
  27. =cut
  28.  
  29. # See after __END__ for more POD documentation
  30.  
  31.  
  32. # Load essentials here, other modules loaded on demand later
  33.  
  34. use strict;
  35. use Carp;
  36. require Exporter;
  37.  
  38.  
  39. ##############################################################################
  40. # Define some constants
  41. #
  42.  
  43. use vars qw($VERSION @ISA @EXPORT);
  44.  
  45. @ISA               = qw(Exporter);
  46. @EXPORT            = qw(XMLin XMLout);
  47. $VERSION           = '1.08';
  48.  
  49. my %CacheScheme    = (
  50.                        storable => [ \&StorableSave, \&StorableRestore ],
  51.                        memshare => [ \&MemShareSave, \&MemShareRestore ],
  52.                        memcopy  => [ \&MemCopySave,  \&MemCopyRestore  ]
  53.              );
  54.  
  55. my $DefaultValues  = 1;       # Used for locking only
  56. my @KnownOptIn     = qw(keyattr keeproot forcecontent contentkey noattr
  57.                         searchpath forcearray cache suppressempty parseropts);
  58. my @KnownOptOut    = qw(keyattr keeproot contentkey noattr
  59.                         rootname xmldecl outputfile noescape suppressempty);
  60. my @DefKeyAttr     = qw(name key id);
  61. my $DefRootName    = qq(opt);
  62. my $DefContentKey  = qq(content);
  63. my $DefXmlDecl     = qq(<?xml version='1.0' standalone='yes'?>);
  64.  
  65.  
  66. ##############################################################################
  67. # Globals for use by caching routines (access protected by locks)
  68. #
  69.  
  70. my %MemShareCache  = ();
  71. my %MemCopyCache   = ();
  72.  
  73.  
  74. ##############################################################################
  75. # Dummy 'lock' routine for non-threaded versions of Perl
  76. #
  77.  
  78. BEGIN {
  79.   if($] < 5.005) {
  80.     eval "sub lock {}";
  81.   }
  82. }
  83.  
  84.  
  85. ##############################################################################
  86. # Constructor for optional object interface.
  87. #
  88.  
  89. sub new {
  90.   my $class = ref($_[0]) || $_[0];      # Works as object or class method
  91.   shift;
  92.  
  93.   if(@_ % 2) {
  94.     croak "Default options must be name=>value pairs (odd number supplied)";
  95.   }
  96.  
  97.   my $self = { defopt => { @_ } };
  98.  
  99.   return(bless($self, $class));
  100. }
  101.  
  102.  
  103. ##############################################################################
  104. # Sub/Method: XMLin()
  105. #
  106. # Exported routine for slurping XML into a hashref - see pod for info.
  107. #
  108. # May be called as object method or as a plain function.
  109. #
  110. # Expects one arg for the source XML, optionally followed by a number of
  111. # name => value option pairs.
  112. #
  113.  
  114. sub XMLin {
  115.  
  116.   # If this is not a method call, create an object
  117.  
  118.   my $self;
  119.   if($_[0]  and  UNIVERSAL::isa($_[0], 'XML::Simple')) {
  120.     $self = shift;
  121.   }
  122.   else {
  123.     $self = new XML::Simple();
  124.   }
  125.  
  126.  
  127.   my $string = shift;
  128.  
  129.   $self->handle_options('in', @_);
  130.  
  131.  
  132.   # If no XML or filename supplied, look for scriptname.xml in script directory
  133.  
  134.   unless(defined($string))  {
  135.     
  136.     # Translate scriptname[.suffix] to scriptname.xml
  137.  
  138.     require File::Basename;
  139.  
  140.     my($ScriptName, $ScriptDir, $Extension) =
  141.       File::Basename::fileparse($0, '\.[^\.]+');
  142.  
  143.     $string = $ScriptName . '.xml';
  144.  
  145.  
  146.     # Add script directory to searchpath
  147.     
  148.     if($ScriptDir) {
  149.       unshift(@{$self->{opt}->{searchpath}}, $ScriptDir);
  150.     }
  151.   }
  152.   
  153.  
  154.   # Are we parsing from a file?  If so, is there a valid cache available?
  155.  
  156.   my($filename, $scheme);
  157.   unless($string =~ m{<.*?>}s  or  ref($string)  or  $string eq '-') {
  158.  
  159.     require File::Basename;
  160.     require File::Spec;
  161.  
  162.     $filename = $self->find_xml_file($string, @{$self->{opt}->{searchpath}});
  163.  
  164.     if($self->{opt}->{cache}) {
  165.       lock(%CacheScheme);
  166.       foreach $scheme (@{$self->{opt}->{cache}}) {
  167.     croak "Unsupported caching scheme: $scheme"
  168.       unless($CacheScheme{$scheme});
  169.  
  170.     my $opt = $CacheScheme{$scheme}->[1]->($filename);
  171.     return($opt) if($opt);
  172.       }
  173.     }
  174.   }
  175.   else {
  176.     delete($self->{opt}->{cache});
  177.     if($string eq '-') {
  178.       # Read from standard input
  179.       $filename = '-';
  180.     }
  181.   }
  182.  
  183.  
  184.   # Parsing is required, so let's get on with it
  185.  
  186.   my $tree =  $self->build_tree($filename, $string);
  187.  
  188.  
  189.   # Now work some magic on the resulting parse tree
  190.  
  191.   my($ref);
  192.   if($self->{opt}->{keeproot}) {
  193.     $ref = $self->collapse({}, @$tree);
  194.   }
  195.   else {
  196.     $ref = $self->collapse(@{$tree->[1]});
  197.   }
  198.  
  199.   if($self->{opt}->{cache}) {
  200.     $CacheScheme{$self->{opt}->{cache}->[0]}->[0]->($ref, $filename);
  201.   }
  202.  
  203.   return($ref);
  204. }
  205.  
  206.  
  207. ##############################################################################
  208. # Method: build_tree()
  209. #
  210. # If parsing is required, this is the routine that does it - using the 'Tree'
  211. # style of XML::Parser.
  212. #
  213. # If you're planning to override this routine, your version should return the
  214. # same type of data structure as an XML::Parser Tree (summarised in the 
  215. # comments for the collapse() routine below).
  216. #
  217.  
  218. sub build_tree {
  219.   my $self     = shift;
  220.   my $filename = shift;
  221.   my $string   = shift;
  222.  
  223.  
  224.   {
  225.     local($^W) = 0;      # Suppress warning from Expat.pm re File::Spec::load()
  226.     require XML::Parser; # We didn't need it until now
  227.   }
  228.  
  229.   my $xp = new XML::Parser(Style => 'Tree', @{$self->{opt}->{parseropts}});
  230.   my($tree);
  231.  
  232.  
  233.   # Work around wierd read error problem in expat with '-'
  234.  
  235.   if($filename  and  $filename eq '-') {
  236.     local($/) = undef;
  237.     $string = <STDIN>;
  238.     $filename = undef;
  239.   }
  240.   if($filename) {
  241.     # $tree = $xp->parsefile($filename);  # Changed due to prob w/mod_perl
  242.     local(*XML_FILE);
  243.     open(XML_FILE, "<$filename") || croak qq($filename - $!);
  244.     $tree = $xp->parse(*XML_FILE);
  245.     close(XML_FILE);
  246.   }
  247.   else {
  248.     $tree = $xp->parse($string);
  249.   }
  250.  
  251.   return($tree);
  252. }
  253.  
  254.  
  255. ##############################################################################
  256. # Sub: StorableSave()
  257. #
  258. # Wrapper routine for invoking Storable::nstore() to cache a parsed data
  259. # structure.
  260. #
  261.  
  262. sub StorableSave {
  263.   my($data, $filename) = @_;
  264.  
  265.   my $cachefile = $filename;
  266.   $cachefile =~ s{(\.xml)?$}{.stor};
  267.  
  268.   require Storable;           # We didn't need it until now
  269.   
  270.   Storable::nstore($data, $cachefile);
  271.   
  272. }
  273.  
  274.  
  275. ##############################################################################
  276. # Sub: StorableRestore()
  277. #
  278. # Wrapper routine for invoking Storable::retrieve() to read a cached parsed
  279. # data structure.  Only returns cached data if the cache file exists and is
  280. # newer than the source XML file.
  281. #
  282.  
  283. sub StorableRestore {
  284.   my($filename) = @_;
  285.   
  286.   my $cachefile = $filename;
  287.   $cachefile =~ s{(\.xml)?$}{.stor};
  288.  
  289.   return unless(-r $cachefile);
  290.   return unless((stat($cachefile))[9] > (stat($filename))[9]);
  291.  
  292.   unless($INC{'Storable.pm'}) {
  293.     require Storable;           # We didn't need it until now
  294.   }
  295.   
  296.   return(Storable::retrieve($cachefile));
  297.   
  298. }
  299.  
  300.  
  301. ##############################################################################
  302. # Sub: MemShareSave()
  303. #
  304. # Takes the supplied data structure reference and stores it away in a global
  305. # hash structure.
  306. #
  307.  
  308. sub MemShareSave {
  309.   my($data, $filename) = @_;
  310.  
  311.   lock(%MemShareCache);
  312.   $MemShareCache{$filename} = [time(), $data];
  313. }
  314.  
  315.  
  316. ##############################################################################
  317. # Sub: MemShareRestore()
  318. #
  319. # Takes a filename and looks in a global hash for a cached parsed version.
  320. #
  321.  
  322. sub MemShareRestore {
  323.   my($filename) = @_;
  324.   
  325.   lock(%MemShareCache);
  326.   return unless($MemShareCache{$filename});
  327.   return unless($MemShareCache{$filename}->[0] > (stat($filename))[9]);
  328.  
  329.   return($MemShareCache{$filename}->[1]);
  330.   
  331. }
  332.  
  333.  
  334. ##############################################################################
  335. # Sub: MemCopySave()
  336. #
  337. # Takes the supplied data structure and stores a copy of it in a global hash
  338. # structure.
  339. #
  340.  
  341. sub MemCopySave {
  342.   my($data, $filename) = @_;
  343.  
  344.   lock(%MemCopyCache);
  345.   unless($INC{'Storable.pm'}) {
  346.     require Storable;           # We didn't need it until now
  347.   }
  348.   
  349.   $MemCopyCache{$filename} = [time(), Storable::dclone($data)];
  350. }
  351.  
  352.  
  353. ##############################################################################
  354. # Sub: MemCopyRestore()
  355. #
  356. # Takes a filename and looks in a global hash for a cached parsed version.
  357. # Returns a reference to a copy of that data structure.
  358. #
  359.  
  360. sub MemCopyRestore {
  361.   my($filename) = @_;
  362.   
  363.   lock(%MemCopyCache);
  364.   return unless($MemCopyCache{$filename});
  365.   return unless($MemCopyCache{$filename}->[0] > (stat($filename))[9]);
  366.  
  367.   return(Storable::dclone($MemCopyCache{$filename}->[1]));
  368.   
  369. }
  370.  
  371.  
  372. ##############################################################################
  373. # Sub/Method: XMLout()
  374. #
  375. # Exported routine for 'unslurping' a data structure out to XML.
  376. #
  377. # Expects a reference to a data structure and an optional list of option
  378. # name => value pairs.
  379. #
  380.  
  381. sub XMLout {
  382.  
  383.   # If this is not a method call, create an object
  384.  
  385.   my $self;
  386.   if($_[0]  and  UNIVERSAL::isa($_[0], 'XML::Simple')) {
  387.     $self = shift;
  388.   }
  389.   else {
  390.     $self = new XML::Simple();
  391.   }
  392.  
  393.  
  394.   my $ref = shift;
  395.  
  396.   $self->handle_options('out', @_);
  397.  
  398.  
  399.   # Wrap top level arrayref in a hash
  400.  
  401.   if(ref($ref) eq 'ARRAY') {
  402.     $ref = { anon => $ref };
  403.   }
  404.  
  405.  
  406.   # Extract rootname from top level hash if keeproot enabled
  407.  
  408.   if($self->{opt}->{keeproot}) {
  409.     my(@keys) = keys(%$ref);
  410.     if(@keys == 1) {
  411.       $ref = $ref->{$keys[0]};
  412.       $self->{opt}->{rootname} = $keys[0];
  413.     }
  414.   }
  415.   
  416.   # Ensure there are no top level attributes if we're not adding root elements
  417.  
  418.   elsif($self->{opt}->{rootname} eq '') {
  419.     if(ref($ref) eq 'HASH') {
  420.       my $refsave = $ref;
  421.       $ref = {};
  422.       foreach (keys(%$refsave)) {
  423.     if(ref($refsave->{$_})) {
  424.       $ref->{$_} = $refsave->{$_};
  425.     }
  426.     else {
  427.       $ref->{$_} = [ $refsave->{$_} ];
  428.     }
  429.       }
  430.     }
  431.   }
  432.  
  433.  
  434.   # Encode the hashref and write to file if necessary
  435.  
  436.   my $xml = $self->value_to_xml($ref, $self->{opt}->{rootname}, {}, '');
  437.   if($self->{opt}->{xmldecl}) {
  438.     $xml = $self->{opt}->{xmldecl} . "\n" . $xml;
  439.   }
  440.  
  441.   if($self->{opt}->{outputfile}) {
  442.     if(ref($self->{opt}->{outputfile})) {
  443.       return($self->{opt}->{outputfile}->print($xml));
  444.     }
  445.     else {
  446.       open(_XML_SIMPLE_OUT_, ">$self->{opt}->{outputfile}") ||
  447.         croak "open($self->{opt}->{outputfile}): $!";
  448.       print _XML_SIMPLE_OUT_ $xml || croak "print: $!";
  449.       close(_XML_SIMPLE_OUT_);
  450.     }
  451.   }
  452.   else {
  453.     return($xml);
  454.   }
  455. }
  456.  
  457.  
  458. ##############################################################################
  459. # Method: handle_options()
  460. #
  461. # Helper routine for both XMLin() and XMLout().  Both routines handle their
  462. # first argument and assume all other args are options handled by this routine.
  463. # Saves a hash of options in $self->{opt}.
  464. #
  465. # If default options were passed to the constructor, they will be retrieved
  466. # here and merged with options supplied to the method call.
  467. #
  468. # First argument should be the string 'in' or the string 'out'.
  469. #
  470. # Remaining arguments should be name=>value pairs.  Sets up default values
  471. # for options not supplied.  Unrecognised options are a fatal error.
  472. #
  473.  
  474. sub handle_options  {
  475.   my $self = shift;
  476.   my $dirn = shift;
  477.  
  478.  
  479.   lock($DefaultValues);
  480.  
  481.   # Determine valid options based on context
  482.  
  483.   my %known_opt; 
  484.   if($dirn eq 'in') {
  485.     @known_opt{@KnownOptIn} = @KnownOptIn;
  486.   }
  487.   else {
  488.     @known_opt{@KnownOptOut} = @KnownOptOut;
  489.   }
  490.  
  491.  
  492.   # Store supplied options in hashref and weed out invalid ones
  493.  
  494.   if(@_ % 2) {
  495.     croak "Options must be name=>value pairs (odd number supplied)";
  496.   }
  497.   my $opt = { @_ };
  498.   $self->{opt} = $opt;
  499.  
  500.   foreach (keys(%$opt)) {
  501.     croak "Unrecognised option: $_"
  502.       unless($known_opt{$_});
  503.   }
  504.  
  505.  
  506.   # Merge in options passed to constructor
  507.  
  508.   if($self->{defopt}) {
  509.     foreach (keys(%known_opt)) {
  510.       unless(exists($opt->{$_})) {
  511.     if(exists($self->{defopt}->{$_})) {
  512.       $opt->{$_} = $self->{defopt}->{$_};
  513.     }
  514.       }
  515.     }
  516.   }
  517.  
  518.  
  519.   # Set sensible defaults if not supplied
  520.   
  521.   if(exists($opt->{rootname})) {
  522.     unless(defined($opt->{rootname})) {
  523.       $opt->{rootname} = '';
  524.     }
  525.   }
  526.   else {
  527.     $opt->{rootname} = $DefRootName;
  528.   }
  529.   
  530.   if($opt->{xmldecl}  and  $opt->{xmldecl} eq '1') {
  531.     $opt->{xmldecl} = $DefXmlDecl;
  532.   }
  533.  
  534.   unless(exists($opt->{contentkey})) {
  535.     $opt->{contentkey} = $DefContentKey;
  536.   }
  537.  
  538.  
  539.   # Cleanups for values assumed to be arrays later
  540.  
  541.   if($opt->{searchpath}) {
  542.     unless(ref($opt->{searchpath})) {
  543.       $opt->{searchpath} = [ $opt->{searchpath} ];
  544.     }
  545.   }
  546.   else  {
  547.     $opt->{searchpath} = [ ];
  548.   }
  549.  
  550.   if($opt->{cache}  and !ref($opt->{cache})) {
  551.     $opt->{cache} = [ $opt->{cache} ];
  552.   }
  553.   
  554.   unless(exists($opt->{parseropts})) {
  555.     $opt->{parseropts} = [ ];
  556.   }
  557.  
  558.  
  559.   # Special cleanup for {keyattr} which could be arrayref or hashref or left
  560.   # to default to arrayref
  561.  
  562.   if(exists($opt->{keyattr}))  {
  563.     if(ref($opt->{keyattr})) {
  564.       if(ref($opt->{keyattr}) eq 'HASH') {
  565.  
  566.     # Make a copy so we can mess with it
  567.  
  568.     $opt->{keyattr} = { %{$opt->{keyattr}} };
  569.  
  570.     
  571.     # Convert keyattr => { elem => '+attr' }
  572.     # to keyattr => { elem => [ 'attr', '+' ] } 
  573.  
  574.     foreach (keys(%{$opt->{keyattr}})) {
  575.       if($opt->{keyattr}->{$_} =~ /^(\+|-)?(.*)$/) {
  576.         $opt->{keyattr}->{$_} = [ $2, ($1 ? $1 : '') ];
  577.       }
  578.       else {
  579.         delete($opt->{keyattr}->{$_}); # Never reached (famous last words?)
  580.       }
  581.     }
  582.       }
  583.       else {
  584.     if(@{$opt->{keyattr}} == 0) {
  585.       delete($opt->{keyattr});
  586.     }
  587.       }
  588.     }
  589.     else {
  590.       $opt->{keyattr} = [ $opt->{keyattr} ];
  591.     }
  592.   }
  593.   else  {
  594.     $opt->{keyattr} = [ @DefKeyAttr ];
  595.   }
  596.  
  597.   
  598.   # Special cleanup for {forcearray} which could be arrayref or boolean
  599.   # or left to default to 0
  600.  
  601.   if(exists($opt->{forcearray})) {
  602.     if(ref($opt->{forcearray}) eq 'ARRAY') {
  603.       if(@{$opt->{forcearray}}) {
  604.         $opt->{forcearray} = { (
  605.       map { $_ => 1 } @{$opt->{forcearray}}
  606.     ) };
  607.       }
  608.       else {
  609.         $opt->{forcearray} = 0;
  610.       }
  611.     }
  612.     else {
  613.       $opt->{forcearray} = ( $opt->{forcearray} ? 1 : 0 );
  614.     }
  615.   }
  616.   else {
  617.     $opt->{forcearray} = 0;
  618.   }
  619.  
  620. }
  621.  
  622.  
  623. ##############################################################################
  624. # Method: find_xml_file()
  625. #
  626. # Helper routine for XMLin().
  627. # Takes a filename, and a list of directories, attempts to locate the file in
  628. # the directories listed.
  629. # Returns a full pathname on success; croaks on failure.
  630. #
  631.  
  632. sub find_xml_file  {
  633.   my $self = shift;
  634.   my $file = shift;
  635.   my @search_path = @_;
  636.  
  637.  
  638.   my($filename, $filedir) =
  639.     File::Basename::fileparse($file);
  640.  
  641.   if($filename ne $file) {        # Ignore searchpath if dir component
  642.     return($file) if(-e $file);
  643.   }
  644.   else {
  645.     my($path);
  646.     foreach $path (@search_path)  {
  647.       my $fullpath = File::Spec->catfile($path, $file);
  648.       return($fullpath) if(-e $fullpath);
  649.     }
  650.   }
  651.  
  652.   # If user did not supply a search path, default to current directory
  653.  
  654.   if(!@search_path) {
  655.     if(-e $file) {
  656.       return($file);
  657.     }
  658.     croak "File does not exist: $file";
  659.   }
  660.  
  661.   croak "Could not find $file in ", join(':', @search_path);
  662. }
  663.  
  664.  
  665. ##############################################################################
  666. # Method: collapse()
  667. #
  668. # Helper routine for XMLin().  This routine really comprises the 'smarts' (or
  669. # value add) of this module.
  670. #
  671. # Takes the parse tree that XML::Parser produced from the supplied XML and
  672. # recurses through it 'collapsing' unnecessary levels of indirection (nested
  673. # arrays etc) to produce a data structure that is easier to work with.
  674. #
  675. # Elements in the original parser tree are represented as an element name
  676. # followed by an arrayref.  The first element of the array is a hashref
  677. # containing the attributes.  The rest of the array contains a list of any
  678. # nested elements as name+arrayref pairs:
  679. #
  680. #  <element name>, [ { <attribute hashref> }, <element name>, [ ... ], ... ]
  681. #
  682. # The special element name '0' (zero) flags text content.
  683. #
  684. # This routine cuts down the noise by discarding any text content consisting of
  685. # only whitespace and then moves the nested elements into the attribute hash
  686. # using the name of the nested element as the hash key and the collapsed
  687. # version of the nested element as the value.  Multiple nested elements with
  688. # the same name will initially be represented as an arrayref, but this may be
  689. # 'folded' into a hashref depending on the value of the keyattr option.
  690. #
  691.  
  692. sub collapse {
  693.   my $self = shift;;
  694.  
  695.  
  696.   # Start with the hash of attributes
  697.   
  698.   my $attr  = shift;
  699.   $attr = {} if($self->{opt}->{noattr});    # Discard if 'noattr' set
  700.  
  701.  
  702.   # Add any nested elements
  703.  
  704.   my($key, $val);
  705.   while(@_) {
  706.     $key = shift;
  707.     $val = shift;
  708.  
  709.     if(ref($val)) {
  710.       $val = $self->collapse(@$val);
  711.       next if(!defined($val)  and  $self->{opt}->{suppressempty});
  712.     }
  713.     elsif($key eq '0') {
  714.       next if($val =~ m{^\s*$}s);  # Skip all whitespace content
  715.       if(!%$attr  and  !@_) {      # Short circuit text in tag with no attr
  716.         return($self->{opt}->{forcecontent} ?
  717.            { $self->{opt}->{contentkey} => $val } : $val
  718.           );
  719.       }
  720.       $key = $self->{opt}->{contentkey};
  721.     }
  722.  
  723.  
  724.     # Combine duplicate attributes into arrayref if required
  725.  
  726.     if(exists($attr->{$key})) {
  727.       if(ref($attr->{$key}) eq 'ARRAY') {
  728.         push(@{$attr->{$key}}, $val);
  729.       }
  730.       else {
  731.         $attr->{$key} = [ $attr->{$key}, $val ];
  732.       }
  733.     }
  734.     elsif(ref($val) eq 'ARRAY') {  # Handle anonymous arrays
  735.       $attr->{$key} = [ $val ];
  736.     }
  737.     else {
  738.       if( $key ne $self->{opt}->{contentkey}  and
  739.           (
  740.         ($self->{opt}->{forcearray} == 1) or
  741.         ( 
  742.           (ref($self->{opt}->{forcearray}) eq 'HASH') and
  743.           ($self->{opt}->{forcearray}->{$key})
  744.         )
  745.       )
  746.     ) {
  747.     $attr->{$key} = [ $val ];
  748.       }
  749.       else {
  750.     $attr->{$key} = $val;
  751.       }
  752.     }
  753.   }
  754.  
  755.  
  756.   # Turn arrayrefs into hashrefs if key fields present
  757.  
  758.   my $count = 0;
  759.   if($self->{opt}->{keyattr}) {
  760.     while(($key,$val) = each %$attr) {
  761.       if(ref($val) eq 'ARRAY') {
  762.     $attr->{$key} = $self->array_to_hash($key, $val);
  763.       }
  764.       $count++;
  765.     }
  766.   }
  767.  
  768.  
  769.   # Fold hashes containing a single anonymous array up into just the array
  770.  
  771.   if($count == 1  and  ref($attr->{anon}) eq 'ARRAY') {
  772.     return($attr->{anon});
  773.   }
  774.  
  775.  
  776.   # Do the right thing if hash is empty, otherwise just return it
  777.  
  778.   if(!%$attr  and  exists($self->{opt}->{suppressempty})) {
  779.     if(defined($self->{opt}->{suppressempty})  and
  780.        $self->{opt}->{suppressempty} eq '') {
  781.       return('');
  782.     }
  783.     return(undef);
  784.   }
  785.  
  786.   return($attr)
  787.  
  788. }
  789.  
  790.  
  791. ##############################################################################
  792. # Method: array_to_hash()
  793. #
  794. # Helper routine for collapse().
  795. # Attempts to 'fold' an array of hashes into an hash of hashes.  Returns a
  796. # reference to the hash on success or the original array if folding is
  797. # not possible.  Behaviour is controlled by 'keyattr' option.
  798. #
  799.  
  800. sub array_to_hash {
  801.   my $self     = shift;
  802.   my $name     = shift;
  803.   my $arrayref = shift;
  804.  
  805.   my $hashref  = {};
  806.  
  807.   my($i, $key, $val, $flag);
  808.  
  809.  
  810.   # Handle keyattr => { .... }
  811.  
  812.   if(ref($self->{opt}->{keyattr}) eq 'HASH') {
  813.     return($arrayref) unless(exists($self->{opt}->{keyattr}->{$name}));
  814.     ($key, $flag) = @{$self->{opt}->{keyattr}->{$name}};
  815.     for($i = 0; $i < @$arrayref; $i++)  {
  816.       if(ref($arrayref->[$i]) eq 'HASH' and exists($arrayref->[$i]->{$key})) {
  817.     $val = $arrayref->[$i]->{$key};
  818.     $hashref->{$val} = { %{$arrayref->[$i]} };
  819.     $hashref->{$val}->{"-$key"} = $hashref->{$val}->{$key} if($flag eq '-');
  820.     delete $hashref->{$val}->{$key} unless($flag eq '+');
  821.       }
  822.       else {
  823.     carp "Warning: <$name> element has no '$key' key attribute" if($^W);
  824.     return($arrayref);
  825.       }
  826.     }
  827.   }
  828.  
  829.  
  830.   # Or assume keyattr => [ .... ]
  831.  
  832.   else {
  833.     ELEMENT: for($i = 0; $i < @$arrayref; $i++)  {
  834.       return($arrayref) unless(ref($arrayref->[$i]) eq 'HASH');
  835.  
  836.       foreach $key (@{$self->{opt}->{keyattr}}) {
  837.     if(defined($arrayref->[$i]->{$key}))  {
  838.       $val = $arrayref->[$i]->{$key};
  839.       $hashref->{$val} = { %{$arrayref->[$i]} };
  840.       delete $hashref->{$val}->{$key};
  841.       next ELEMENT;
  842.     }
  843.       }
  844.  
  845.       return($arrayref);    # No keyfield matched
  846.     }
  847.   }
  848.  
  849.   return($hashref);
  850. }
  851.  
  852.  
  853. ##############################################################################
  854. # Method: value_to_xml()
  855. #
  856. # Helper routine for XMLout() - recurses through a data structure building up
  857. # and returning an XML representation of that structure as a string.
  858. # 
  859. # Arguments expected are:
  860. # - the data structure to be encoded (usually a reference)
  861. # - the XML tag name to use for this item
  862. # - a hashref of references already encoded (to detect recursive structures)
  863. # - a string of spaces for use as the current indent level
  864. #
  865.  
  866. sub value_to_xml {
  867.   my $self = shift;;
  868.  
  869.  
  870.   # Grab the other arguments
  871.  
  872.   my($ref, $name, $encoded, $indent) = @_;
  873.  
  874.   my $named = (defined($name) and $name ne '' ? 1 : 0);
  875.  
  876.   my $nl = "\n";
  877.  
  878.   if(ref($ref)) {
  879.     croak "recursive data structures not supported" if($encoded->{$ref});
  880.     $encoded->{$ref} = $ref;
  881.   }
  882.   else {
  883.     if($named) {
  884.       return(join('',
  885.               $indent, '<', $name, '>',
  886.           ($self->{opt}->{noescape} ? $ref : $self->escape_value($ref)),
  887.               '</', $name, ">", $nl
  888.         ));
  889.     }
  890.     else {
  891.       return("$ref$nl");
  892.     }
  893.   }
  894.  
  895.   # Unfold hash to array if possible
  896.  
  897.   if(ref($ref) eq 'HASH'               # It is a hash
  898.      and %$ref                         # and it's not empty
  899.      and $self->{opt}->{keyattr}       # and folding is enabled
  900.      and $indent                       # and its not the root element
  901.   ) {
  902.     $ref = $self->hash_to_array($name, $ref);
  903.   }
  904.  
  905.   
  906.   my @result = ();
  907.   my($key, $value);
  908.  
  909.  
  910.   # Handle hashrefs
  911.  
  912.   if(ref($ref) eq 'HASH') {
  913.     my @nested = ();
  914.     my $text_content = undef;
  915.     if($named) {
  916.       push @result, $indent, '<', $name;
  917.     }
  918.  
  919.     if(%$ref) {
  920.       while(($key, $value) = each(%$ref)) {
  921.     next if(substr($key, 0, 1) eq '-');
  922.     if(!defined($value)) {
  923.       unless(exists($self->{opt}->{suppressempty})
  924.          and !defined($self->{opt}->{suppressempty})
  925.       ) {
  926.         carp 'Use of uninitialized value';
  927.       }
  928.       $value = {};
  929.     }
  930.     if(ref($value)  or  $self->{opt}->{noattr}) {
  931.       push @nested,
  932.         $self->value_to_xml($value, $key, $encoded, "$indent  ");
  933.     }
  934.     else {
  935.       $value = $self->escape_value($value) unless($self->{opt}->{noescape});
  936.       if($key eq $self->{opt}->{contentkey}) {
  937.         $text_content = $value;
  938.       }
  939.       else {
  940.         push @result, ' ', $key, '="', $value , '"';
  941.       }
  942.     }
  943.       }
  944.     }
  945.     else {
  946.       $text_content = '';
  947.     }
  948.  
  949.     if(@nested  or  defined($text_content)) {
  950.       if($named) {
  951.         push @result, ">";
  952.     if(defined($text_content)) {
  953.       push @result, $text_content;
  954.       $nested[0] =~ s/^\s+// if(@nested);
  955.     }
  956.     else {
  957.       push @result, $nl;
  958.     }
  959.     if(@nested) {
  960.       push @result, @nested, $indent;
  961.     }
  962.     push @result, '</', $name, ">", $nl;
  963.       }
  964.       else {
  965.         push @result, @nested;             # Special case if no root elements
  966.       }
  967.     }
  968.     else {
  969.       push @result, " />", $nl;
  970.     }
  971.   }
  972.  
  973.  
  974.   # Handle arrayrefs
  975.  
  976.   elsif(ref($ref) eq 'ARRAY') {
  977.     foreach $value (@$ref) {
  978.       if(!ref($value)) {
  979.         push @result,
  980.          $indent, '<', $name, '>',
  981.          ($self->{opt}->{noescape} ? $value : $self->escape_value($value)),
  982.          '</', $name, ">\n";
  983.       }
  984.       elsif(ref($value) eq 'HASH') {
  985.     push @result, $self->value_to_xml($value, $name, $encoded, $indent);
  986.       }
  987.       else {
  988.     push @result,
  989.            $indent, '<', $name, ">\n",
  990.            $self->value_to_xml($value, 'anon', $encoded, "$indent  "),
  991.            $indent, '</', $name, ">\n";
  992.       }
  993.     }
  994.   }
  995.  
  996.   else {
  997.     croak "Can't encode a value of type: " . ref($ref);
  998.   }
  999.  
  1000.   return(join('', @result));
  1001. }
  1002.  
  1003.  
  1004. ##############################################################################
  1005. # Method: escape_value()
  1006. #
  1007. # Helper routine for automatically escaping values for XMLout().
  1008. # Expects a scalar data value.  Returns escaped version.
  1009. #
  1010.  
  1011. sub escape_value {
  1012.   my $self = shift;
  1013.  
  1014.   my($data) = @_;
  1015.  
  1016.   $data =~ s/&/&/sg;
  1017.   $data =~ s/</</sg;
  1018.   $data =~ s/>/>/sg;
  1019.   $data =~ s/"/"/sg;
  1020.  
  1021.   return($data);
  1022. }
  1023.  
  1024.  
  1025. ##############################################################################
  1026. # Method: hash_to_array()
  1027. #
  1028. # Helper routine for value_to_xml().
  1029. # Attempts to 'unfold' a hash of hashes into an array of hashes.  Returns a
  1030. # reference to the array on success or the original hash if unfolding is
  1031. # not possible.
  1032. #
  1033.  
  1034. sub hash_to_array {
  1035.   my $self    = shift;
  1036.   my $parent  = shift;
  1037.   my $hashref = shift;
  1038.  
  1039.   my $arrayref = [];
  1040.  
  1041.   my($key, $value);
  1042.  
  1043.   foreach $key (keys(%$hashref)) {
  1044.     $value = $hashref->{$key};
  1045.     return($hashref) unless(ref($value) eq 'HASH');
  1046.  
  1047.     if(ref($self->{opt}->{keyattr}) eq 'HASH') {
  1048.       return($hashref) unless(defined($self->{opt}->{keyattr}->{$parent}));
  1049.       push(@$arrayref, { $self->{opt}->{keyattr}->{$parent}->[0] => $key,
  1050.                          %$value });
  1051.     }
  1052.     else {
  1053.       push(@$arrayref, { $self->{opt}->{keyattr}->[0] => $key, %$value });
  1054.     }
  1055.   }
  1056.  
  1057.   return($arrayref);
  1058. }
  1059.  
  1060. 1;
  1061.  
  1062. __END__
  1063.  
  1064. =head1 QUICK START
  1065.  
  1066. Say you have a script called B<foo> and a file of configuration options
  1067. called B<foo.xml> containing this:
  1068.  
  1069.   <config logdir="/var/log/foo/" debugfile="/tmp/foo.debug">
  1070.     <server name="sahara" osname="solaris" osversion="2.6">
  1071.       <address>10.0.0.101</address>
  1072.       <address>10.0.1.101</address>
  1073.     </server>
  1074.     <server name="gobi" osname="irix" osversion="6.5">
  1075.       <address>10.0.0.102</address>
  1076.     </server>
  1077.     <server name="kalahari" osname="linux" osversion="2.0.34">
  1078.       <address>10.0.0.103</address>
  1079.       <address>10.0.1.103</address>
  1080.     </server>
  1081.   </config>
  1082.  
  1083. The following lines of code in B<foo>:
  1084.  
  1085.   use XML::Simple;
  1086.  
  1087.   my $config = XMLin();
  1088.  
  1089. will 'slurp' the configuration options into the hashref $config (because no
  1090. arguments are passed to C<XMLin()> the name and location of the XML file will
  1091. be inferred from name and location of the script).  You can dump out the
  1092. contents of the hashref using Data::Dumper:
  1093.  
  1094.   use Data::Dumper;
  1095.  
  1096.   print Dumper($config);
  1097.  
  1098. which will produce something like this (formatting has been adjusted for
  1099. brevity):
  1100.  
  1101.   {
  1102.       'logdir'        => '/var/log/foo/',
  1103.       'debugfile'     => '/tmp/foo.debug',
  1104.       'server'        => {
  1105.       'sahara'        => {
  1106.           'osversion'     => '2.6',
  1107.           'osname'        => 'solaris',
  1108.           'address'       => [ '10.0.0.101', '10.0.1.101' ]
  1109.       },
  1110.       'gobi'          => {
  1111.           'osversion'     => '6.5',
  1112.           'osname'        => 'irix',
  1113.           'address'       => '10.0.0.102'
  1114.       },
  1115.       'kalahari'      => {
  1116.           'osversion'     => '2.0.34',
  1117.           'osname'        => 'linux',
  1118.           'address'       => [ '10.0.0.103', '10.0.1.103' ]
  1119.       }
  1120.       }
  1121.   }
  1122.  
  1123. Your script could then access the name of the log directory like this:
  1124.  
  1125.   print $config->{logdir};
  1126.  
  1127. similarly, the second address on the server 'kalahari' could be referenced as:
  1128.  
  1129.   print $config->{server}->{kalahari}->{address}->[1];
  1130.  
  1131. What could be simpler?  (Rhetorical).
  1132.  
  1133. For simple requirements, that's really all there is to it.  If you want to
  1134. store your XML in a different directory or file, or pass it in as a string or
  1135. even pass it in via some derivative of an IO::Handle, you'll need to check out
  1136. L<"OPTIONS">.  If you want to turn off or tweak the array folding feature (that
  1137. neat little transformation that produced $config->{server}) you'll find options
  1138. for that as well.
  1139.  
  1140. If you want to generate XML (for example to write a modified version of
  1141. $config back out as XML), check out C<XMLout()>.
  1142.  
  1143. If your needs are not so simple, this may not be the module for you.  In that
  1144. case, you might want to read L<"WHERE TO FROM HERE?">.
  1145.  
  1146. =head1 DESCRIPTION
  1147.  
  1148. The XML::Simple module provides a simple API layer on top of the XML::Parser
  1149. module.  Two functions are exported: C<XMLin()> and C<XMLout()>.
  1150.  
  1151. The most common approach is to simply call these two functions directly, but an
  1152. optional object oriented interface (see L<"OPTIONAL OO INTERFACE"> below)
  1153. allows them to be called as methods of an B<XML::Simple> object.
  1154.  
  1155. =head2 XMLin()
  1156.  
  1157. Parses XML formatted data and returns a reference to a data structure which
  1158. contains the same information in a more readily accessible form.  (Skip
  1159. down to L<"EXAMPLES"> below, for more sample code).
  1160.  
  1161. C<XMLin()> accepts an optional XML specifier followed by zero or more 'name =>
  1162. value' option pairs.  The XML specifier can be one of the following:
  1163.  
  1164. =over 4
  1165.  
  1166. =item A filename
  1167.  
  1168. If the filename contains no directory components C<XMLin()> will look for the
  1169. file in each directory in the searchpath (see L<"OPTIONS"> below).  eg:
  1170.  
  1171.   $ref = XMLin('/etc/params.xml');
  1172.  
  1173. Note, the filename '-' can be used to parse from STDIN.
  1174.  
  1175. =item undef
  1176.  
  1177. If there is no XML specifier, C<XMLin()> will check the script directory and
  1178. each of the searchpath directories for a file with the same name as the script
  1179. but with the extension '.xml'.  Note: if you wish to specify options, you
  1180. must specify the value 'undef'.  eg:
  1181.  
  1182.   $ref = XMLin(undef, forcearray => 1);
  1183.  
  1184. =item A string of XML
  1185.  
  1186. A string containing XML (recognised by the presence of '<' and '>' characters)
  1187. will be parsed directly.  eg:
  1188.  
  1189.   $ref = XMLin('<opt username="bob" password="flurp" />');
  1190.  
  1191. =item An IO::Handle object
  1192.  
  1193. An IO::Handle object will be read to EOF and its contents parsed. eg:
  1194.  
  1195.   $fh = new IO::File('/etc/params.xml');
  1196.   $ref = XMLin($fh);
  1197.  
  1198. =back
  1199.  
  1200. =head2 XMLout()
  1201.  
  1202. Takes a data structure (generally a hashref) and returns an XML encoding of
  1203. that structure.  If the resulting XML is parsed using C<XMLin()>, it will
  1204. return a data structure equivalent to the original. 
  1205.  
  1206. When translating hashes to XML, hash keys which have a leading '-' will be
  1207. silently skipped.  This is the approved method for marking elements of a
  1208. data structure which should be ignored by C<XMLout>.  (Note: If these items
  1209. were not skipped the key names would be emitted as element or attribute names
  1210. with a leading '-' which would not be valid XML).
  1211.  
  1212. =head2 Caveats
  1213.  
  1214. Some care is required in creating data structures which will be passed to
  1215. C<XMLout()>.  Hash keys from the data structure will be encoded as either XML
  1216. element names or attribute names.  Therefore, you should use hash key names 
  1217. which conform to the relatively strict XML naming rules:
  1218.  
  1219. Names in XML must begin with a letter.  The remaining characters may be
  1220. letters, digits, hyphens (-), underscores (_) or full stops (.).  It is also
  1221. allowable to include one colon (:) in an element name but this should only be
  1222. used when working with namespaces - a facility well beyond the scope of
  1223. B<XML::Simple>.
  1224.  
  1225. You can use other punctuation characters in hash values (just not in hash
  1226. keys) however B<XML::Simple> does not support dumping binary data.
  1227.  
  1228. If you break these rules, the current implementation of C<XMLout()> will 
  1229. simply emit non-compliant XML which will be rejected if you try to read it
  1230. back in.  (A later version of B<XML::Simple> might take a more proactive
  1231. approach).
  1232.  
  1233. Note also that although you can nest hashes and arrays to arbitrary levels,
  1234. recursive data structures are not supported and will cause C<XMLout()> to die.
  1235.  
  1236. Refer to L<"WHERE TO FROM HERE?"> if C<XMLout()> is too simple for your needs.
  1237.  
  1238.  
  1239. =head1 OPTIONS
  1240.  
  1241. B<XML::Simple> supports a number of options (in fact as each release of
  1242. B<XML::Simple> adds more options, the module's claim to the name 'Simple'
  1243. becomes more tenuous).  If you find yourself repeatedly having to specify
  1244. the same options, you might like to investigate L<"OPTIONAL OO INTERFACE">
  1245. below.
  1246.  
  1247. Because there are so many options, it's hard for new users to know which ones
  1248. are important, so here are the two you really need to know about:
  1249.  
  1250. =over 4
  1251.  
  1252. =item *
  1253.  
  1254. check out 'forcearray' because you'll almost certainly want to turn it on
  1255.  
  1256. =item *
  1257.  
  1258. make sure you know what the 'keyattr' option does and what its default value
  1259. is because it may surprise you otherwise
  1260.  
  1261. =back
  1262.  
  1263. Both C<XMLin()> and C<XMLout()> expect a single argument followed by a list of
  1264. options.  An option takes the form of a 'name => value' pair.  The options
  1265. listed below are marked with 'B<in>' if they are recognised by C<XMLin()> and
  1266. 'B<out>' if they are recognised by C<XMLout()>.
  1267.  
  1268. =over 4
  1269.  
  1270. =item keyattr => [ list ] (B<in+out>)
  1271.  
  1272. This option controls the 'array folding' feature which translates nested
  1273. elements from an array to a hash.  For example, this XML:
  1274.  
  1275.     <opt>
  1276.       <user login="grep" fullname="Gary R Epstein" />
  1277.       <user login="stty" fullname="Simon T Tyson" />
  1278.     </opt>
  1279.  
  1280. would, by default, parse to this:
  1281.  
  1282.     {
  1283.       'user' => [
  1284.           {
  1285.             'login' => 'grep',
  1286.             'fullname' => 'Gary R Epstein'
  1287.           },
  1288.           {
  1289.             'login' => 'stty',
  1290.             'fullname' => 'Simon T Tyson'
  1291.           }
  1292.         ]
  1293.     }
  1294.  
  1295. If the option 'keyattr => "login"' were used to specify that the 'login'
  1296. attribute is a key, the same XML would parse to:
  1297.  
  1298.     {
  1299.       'user' => {
  1300.           'stty' => {
  1301.                   'fullname' => 'Simon T Tyson'
  1302.                 },
  1303.           'grep' => {
  1304.                   'fullname' => 'Gary R Epstein'
  1305.                 }
  1306.         }
  1307.     }
  1308.  
  1309. The key attribute names should be supplied in an arrayref if there is more
  1310. than one.  C<XMLin()> will attempt to match attribute names in the order
  1311. supplied.  C<XMLout()> will use the first attribute name supplied when
  1312. 'unfolding' a hash into an array.
  1313.  
  1314. Note: the keyattr option controls the folding of arrays.  By default a single
  1315. nested element will be rolled up into a scalar rather than an array and
  1316. therefore will not be folded.  Use the 'forcearray' option (below) to force
  1317. nested elements to be parsed into arrays and therefore candidates for folding
  1318. into hashes.
  1319.  
  1320. The default value for 'keyattr' is ['name', 'key', 'id'].  Setting this option
  1321. to an empty list will disable the array folding feature.
  1322.  
  1323. =item keyattr => { list } (B<in+out>)
  1324.  
  1325. This alternative method of specifiying the key attributes allows more fine
  1326. grained control over which elements are folded and on which attributes.  For
  1327. example the option 'keyattr => { package => 'id' } will cause any package
  1328. elements to be folded on the 'id' attribute.  No other elements which have an
  1329. 'id' attribute will be folded at all. 
  1330.  
  1331. Note: C<XMLin()> will generate a warning if this syntax is used and an element
  1332. which does not have the specified key attribute is encountered (eg: a 'package'
  1333. element without an 'id' attribute, to use the example above).  Warnings will
  1334. only be generated if B<-w> is in force.
  1335.  
  1336. Two further variations are made possible by prefixing a '+' or a '-' character
  1337. to the attribute name:
  1338.  
  1339. The option 'keyattr => { user => "+login" }' will cause this XML:
  1340.  
  1341.     <opt>
  1342.       <user login="grep" fullname="Gary R Epstein" />
  1343.       <user login="stty" fullname="Simon T Tyson" />
  1344.     </opt>
  1345.  
  1346. to parse to this data structure:
  1347.  
  1348.     {
  1349.       'user' => {
  1350.           'stty' => {
  1351.                   'fullname' => 'Simon T Tyson',
  1352.                   'login'    => 'stty'
  1353.                 },
  1354.           'grep' => {
  1355.                   'fullname' => 'Gary R Epstein',
  1356.                   'login'    => 'grep'
  1357.                 }
  1358.         }
  1359.     }
  1360.  
  1361. The '+' indicates that the value of the key attribute should be copied rather than
  1362. moved to the folded hash key.
  1363.  
  1364. A '-' prefix would produce this result:
  1365.  
  1366.     {
  1367.       'user' => {
  1368.           'stty' => {
  1369.                   'fullname' => 'Simon T Tyson',
  1370.                   '-login'    => 'stty'
  1371.                 },
  1372.           'grep' => {
  1373.                   'fullname' => 'Gary R Epstein',
  1374.                   '-login'    => 'grep'
  1375.                 }
  1376.         }
  1377.     }
  1378.  
  1379. As described earlier, C<XMLout> will ignore hash keys starting with a '-'.
  1380.  
  1381. =item searchpath => [ list ] (B<in>)
  1382.  
  1383. Where the XML is being read from a file, and no path to the file is specified,
  1384. this attribute allows you to specify which directories should be searched.
  1385.  
  1386. If the first parameter to C<XMLin()> is undefined, the default searchpath
  1387. will contain only the directory in which the script itself is located.
  1388. Otherwise the default searchpath will be empty.  
  1389.  
  1390. Note: the current directory ('.') is B<not> searched unless it is the directory
  1391. containing the script.
  1392.  
  1393. =item forcearray => 1 (B<in>)
  1394.  
  1395. This option should be set to '1' to force nested elements to be represented
  1396. as arrays even when there is only one.  Eg, with forcearray enabled, this
  1397. XML:
  1398.  
  1399.     <opt>
  1400.       <name>value</name>
  1401.     </opt>
  1402.  
  1403. would parse to this:
  1404.  
  1405.     {
  1406.       'name' => [
  1407.           'value'
  1408.         ]
  1409.     }
  1410.  
  1411. instead of this (the default):
  1412.  
  1413.     {
  1414.       'name' => 'value'
  1415.     }
  1416.  
  1417. This option is especially useful if the data structure is likely to be written
  1418. back out as XML and the default behaviour of rolling single nested elements up
  1419. into attributes is not desirable. 
  1420.  
  1421. If you are using the array folding feature, you should almost certainly enable
  1422. this option.  If you do not, single nested elements will not be parsed to
  1423. arrays and therefore will not be candidates for folding to a hash.  (Given that
  1424. the default value of 'keyattr' enables array folding, the default value of this
  1425. option should probably also have been enabled too - sorry).
  1426.  
  1427. =item forcearray => [ name(s) ] (B<in>)
  1428.  
  1429. This alternative form of the 'forcearray' option allows you to specify a list
  1430. of element names which should always be forced into an array representation,
  1431. rather than the 'all or nothing' approach above.
  1432.  
  1433. =item noattr => 1 (B<in+out>)
  1434.  
  1435. When used with C<XMLout()>, the generated XML will contain no attributes.
  1436. All hash key/values will be represented as nested elements instead.
  1437.  
  1438. When used with C<XMLin()>, any attributes in the XML will be ignored.
  1439.  
  1440. =item suppressempty => 1 | '' | undef (B<in>)
  1441.  
  1442. This option controls what C<XMLin()> should do with empty elements (no
  1443. attributes and no content).  The default behaviour is to represent them as
  1444. empty hashes.  Setting this option to a true value (eg: 1) will cause empty
  1445. elements to be skipped altogether.  Setting the option to 'undef' or the empty
  1446. string will cause empty elements to be represented as the undefined value or
  1447. the empty string respectively.  The latter two alternatives are a little
  1448. easier to test for in your code than a hash with no keys.
  1449.  
  1450. =item cache => [ cache scheme(s) ] (B<in>)
  1451.  
  1452. Because loading the B<XML::Parser> module and parsing an XML file can consume a
  1453. significant number of CPU cycles, it is often desirable to cache the output of
  1454. C<XMLin()> for later reuse.
  1455.  
  1456. When parsing from a named file, B<XML::Simple> supports a number of caching
  1457. schemes.  The 'cache' option may be used to specify one or more schemes (using
  1458. an anonymous array).  Each scheme will be tried in turn in the hope of finding
  1459. a cached pre-parsed representation of the XML file.  If no cached copy is
  1460. found, the file will be parsed and the first cache scheme in the list will be
  1461. used to save a copy of the results.  The following cache schemes have been
  1462. implemented:
  1463.  
  1464. =over 4
  1465.  
  1466. =item storable
  1467.  
  1468. Utilises B<Storable.pm> to read/write a cache file with the same name as the
  1469. XML file but with the extension .stor
  1470.  
  1471. =item memshare
  1472.  
  1473. When a file is first parsed, a copy of the resulting data structure is retained
  1474. in memory in the B<XML::Simple> module's namespace.  Subsequent calls to parse
  1475. the same file will return a reference to this structure.  This cached version
  1476. will persist only for the life of the Perl interpreter (which in the case of
  1477. mod_perl for example, may be some significant time).
  1478.  
  1479. Because each caller receives a reference to the same data structure, a change
  1480. made by one caller will be visible to all.  For this reason, the reference
  1481. returned should be treated as read-only.
  1482.  
  1483. =item memcopy
  1484.  
  1485. This scheme works identically to 'memshare' (above) except that each caller
  1486. receives a reference to a new data structure which is a copy of the cached
  1487. version.  Copying the data structure will add a little processing overhead,
  1488. therefore this scheme should only be used where the caller intends to modify
  1489. the data structure (or wishes to protect itself from others who might).  This
  1490. scheme uses B<Storable.pm> to perform the copy.
  1491.  
  1492. =back
  1493.  
  1494. =item keeproot => 1 (B<in+out>)
  1495.  
  1496. In its attempt to return a data structure free of superfluous detail and
  1497. unnecessary levels of indirection, C<XMLin()> normally discards the root
  1498. element name.  Setting the 'keeproot' option to '1' will cause the root element
  1499. name to be retained.  So after executing this code:
  1500.  
  1501.   $config = XMLin('<config tempdir="/tmp" />', keeproot => 1)
  1502.  
  1503. You'll be able to reference the tempdir as
  1504. C<$config-E<gt>{config}-E<gt>{tempdir}> instead of the default
  1505. C<$config-E<gt>{tempdir}>.
  1506.  
  1507. Similarly, setting the 'keeproot' option to '1' will tell C<XMLout()> that the
  1508. data structure already contains a root element name and it is not necessary to
  1509. add another.
  1510.  
  1511. =item rootname => 'string' (B<out>)
  1512.  
  1513. By default, when C<XMLout()> generates XML, the root element will be named
  1514. 'opt'.  This option allows you to specify an alternative name.
  1515.  
  1516. Specifying either undef or the empty string for the rootname option will
  1517. produce XML with no root elements.  In most cases the resulting XML fragment
  1518. will not be 'well formed' and therefore could not be read back in by C<XMLin()>.
  1519. Nevertheless, the option has been found to be useful in certain circumstances.
  1520.  
  1521. =item forcecontent (B<in>)
  1522.  
  1523. When C<XMLin()> parses elements which have text content as well as attributes,
  1524. the text content must be represented as a hash value rather than a simple
  1525. scalar.  This option allows you to force text content to always parse to
  1526. a hash value even when there are no attributes.  So for example:
  1527.  
  1528.   XMLin('<opt><x>text1</x><y a="2">text2</y></opt>', forcecontent => 1)
  1529.  
  1530. will parse to:
  1531.  
  1532.   {
  1533.     'x' => {           'content' => 'text1' },
  1534.     'y' => { 'a' => 2, 'content' => 'text2' }
  1535.   }
  1536.  
  1537. instead of:
  1538.  
  1539.   {
  1540.     'x' => 'text1',
  1541.     'y' => { 'a' => 2, 'content' => 'text2' }
  1542.   }
  1543.  
  1544. =item contentkey => 'keyname' (B<in+out>)
  1545.  
  1546. When text content is parsed to a hash value, this option let's you specify a
  1547. name for the hash key to override the default 'content'.  So for example:
  1548.  
  1549.   XMLin('<opt one="1">Text</opt>', contentkey => 'text')
  1550.  
  1551. will parse to:
  1552.  
  1553.   { 'one' => 1, 'text' => 'Text' }
  1554.  
  1555. instead of:
  1556.  
  1557.   { 'one' => 1, 'content' => 'Text' }
  1558.  
  1559. C<XMLout()> will also honour the value of this option when converting a hashref
  1560. to XML.
  1561.  
  1562. =item xmldecl => 1  or  xmldecl => 'string'  (B<out>)
  1563.  
  1564. If you want the output from C<XMLout()> to start with the optional XML
  1565. declaration, simply set the option to '1'.  The default XML declaration is:
  1566.  
  1567.         <?xml version='1.0' standalone='yes'?>
  1568.  
  1569. If you want some other string (for example to declare an encoding value), set
  1570. the value of this option to the complete string you require.
  1571.  
  1572. =item outputfile => <file specifier> (B<out>)
  1573.  
  1574. The default behaviour of C<XMLout()> is to return the XML as a string.  If you
  1575. wish to write the XML to a file, simply supply the filename using the
  1576. 'outputfile' option.  Alternatively, you can supply an IO handle object instead
  1577. of a filename.
  1578.  
  1579. =item noescape => 1 (B<out>)
  1580.  
  1581. By default, C<XMLout()> will translate the characters 'E<lt>', 'E<gt>', '&' and
  1582. '"' to '<', '>', '&' and '"' respectively.  Use this option to
  1583. suppress escaping (presumably because you've already escaped the data in some
  1584. more sophisticated manner).
  1585.  
  1586. =item parseropts => [ XML::Parser Options ] (B<in>)
  1587.  
  1588. Use this option to specify parameters that should be passed to the constructor
  1589. of the underlying XML::Parser object.  For example to turn on the namespace processing mode, you could say:
  1590.  
  1591.   XMLin($xml, parseropts => [ Namespaces => 1 ])
  1592.  
  1593. =back
  1594.  
  1595. =head1 OPTIONAL OO INTERFACE
  1596.  
  1597. The procedural interface is both simple and convenient however there are a
  1598. couple of reasons why you might prefer to use the object oriented (OO)
  1599. interface:
  1600.  
  1601. =over 4
  1602.  
  1603. =item *
  1604.  
  1605. to define a set of default values which should be used on all subsequent calls
  1606. to C<XMLin()> or C<XMLout()>
  1607.  
  1608. =item *
  1609.  
  1610. to override methods in B<XML::Simple> to provide customised behaviour
  1611.  
  1612. =back
  1613.  
  1614. The default values for the options described above are unlikely to suit
  1615. everyone.  The OO interface allows you to effectively override B<XML::Simple>'s
  1616. defaults with your preferred values.  It works like this:
  1617.  
  1618. First create an XML::Simple parser object with your preferred defaults:
  1619.  
  1620.   my $xs = new XML::Simple(forcearray => 1, keeproot => 1);
  1621.  
  1622. then call C<XMLin()> or C<XMLout()> as a method of that object:
  1623.  
  1624.   my $ref = $xs->XMLin($xml);
  1625.   my $xml = $xs->XMLout($ref);
  1626.  
  1627. You can also specify options when you make the method calls and these values
  1628. will be merged with the values specified when the object was created.  Values
  1629. specified in a method call take precedence.
  1630.  
  1631. Overriding methods is a more advanced topic but might be useful if for example
  1632. you wished to provide an alternative routine for escaping character data (the
  1633. escape_value method) or for building the initial parse tree (the build_tree
  1634. method).
  1635.  
  1636. =head1 ERROR HANDLING
  1637.  
  1638. The XML standard is very clear on the issue of non-compliant documents.  An
  1639. error in parsing any single element (for example a missing end tag) must cause
  1640. the whole document to be rejected.  B<XML::Simple> will die with an
  1641. appropriate message if it encounters a parsing error.
  1642.  
  1643. If dying is not appropriate for your application, you should arrange to call
  1644. C<XMLin()> in an eval block and look for errors in $@.  eg:
  1645.  
  1646.     my $config = eval { XMLin() };
  1647.     PopUpMessage($@) if($@);
  1648.  
  1649. Note, there is a common misconception that use of B<eval> will significantly
  1650. slow down a script.  While that may be true when the code being eval'd is in a
  1651. string, it is not true of code like the sample above.
  1652.  
  1653. =head1 EXAMPLES
  1654.  
  1655. When C<XMLin()> reads the following very simple piece of XML:
  1656.  
  1657.     <opt username="testuser" password="frodo"></opt>
  1658.  
  1659. it returns the following data structure:
  1660.  
  1661.     {
  1662.       'username' => 'testuser',
  1663.       'password' => 'frodo'
  1664.     }
  1665.  
  1666. The identical result could have been produced with this alternative XML:
  1667.  
  1668.     <opt username="testuser" password="frodo" />
  1669.  
  1670. Or this (although see 'forcearray' option for variations):
  1671.  
  1672.     <opt>
  1673.       <username>testuser</username>
  1674.       <password>frodo</password>
  1675.     </opt>
  1676.  
  1677. Repeated nested elements are represented as anonymous arrays:
  1678.  
  1679.     <opt>
  1680.       <person firstname="Joe" lastname="Smith">
  1681.         <email>joe@smith.com</email>
  1682.         <email>jsmith@yahoo.com</email>
  1683.       </person>
  1684.       <person firstname="Bob" lastname="Smith">
  1685.         <email>bob@smith.com</email>
  1686.       </person>
  1687.     </opt>
  1688.  
  1689.     {
  1690.       'person' => [
  1691.                     {
  1692.                       'email' => [
  1693.                                    'joe@smith.com',
  1694.                                    'jsmith@yahoo.com'
  1695.                                  ],
  1696.                       'firstname' => 'Joe',
  1697.                       'lastname' => 'Smith'
  1698.                     },
  1699.                     {
  1700.                       'email' => 'bob@smith.com',
  1701.                       'firstname' => 'Bob',
  1702.                       'lastname' => 'Smith'
  1703.                     }
  1704.                   ]
  1705.     }
  1706.  
  1707. Nested elements with a recognised key attribute are transformed (folded) from
  1708. an array into a hash keyed on the value of that attribute:
  1709.  
  1710.     <opt>
  1711.       <person key="jsmith" firstname="Joe" lastname="Smith" />
  1712.       <person key="tsmith" firstname="Tom" lastname="Smith" />
  1713.       <person key="jbloggs" firstname="Joe" lastname="Bloggs" />
  1714.     </opt>
  1715.  
  1716.     {
  1717.       'person' => {
  1718.                     'jbloggs' => {
  1719.                                    'firstname' => 'Joe',
  1720.                                    'lastname' => 'Bloggs'
  1721.                                  },
  1722.                     'tsmith' => {
  1723.                                   'firstname' => 'Tom',
  1724.                                   'lastname' => 'Smith'
  1725.                                 },
  1726.                     'jsmith' => {
  1727.                                   'firstname' => 'Joe',
  1728.                                   'lastname' => 'Smith'
  1729.                                 }
  1730.                   }
  1731.     }
  1732.  
  1733.  
  1734. The <anon> tag can be used to form anonymous arrays:
  1735.  
  1736.     <opt>
  1737.       <head><anon>Col 1</anon><anon>Col 2</anon><anon>Col 3</anon></head>
  1738.       <data><anon>R1C1</anon><anon>R1C2</anon><anon>R1C3</anon></data>
  1739.       <data><anon>R2C1</anon><anon>R2C2</anon><anon>R2C3</anon></data>
  1740.       <data><anon>R3C1</anon><anon>R3C2</anon><anon>R3C3</anon></data>
  1741.     </opt>
  1742.  
  1743.     {
  1744.       'head' => [
  1745.           [ 'Col 1', 'Col 2', 'Col 3' ]
  1746.         ],
  1747.       'data' => [
  1748.           [ 'R1C1', 'R1C2', 'R1C3' ],
  1749.           [ 'R2C1', 'R2C2', 'R2C3' ],
  1750.           [ 'R3C1', 'R3C2', 'R3C3' ]
  1751.         ]
  1752.     }
  1753.  
  1754. Anonymous arrays can be nested to arbirtrary levels and as a special case, if
  1755. the surrounding tags for an XML document contain only an anonymous array the
  1756. arrayref will be returned directly rather than the usual hashref:
  1757.  
  1758.     <opt>
  1759.       <anon><anon>Col 1</anon><anon>Col 2</anon></anon>
  1760.       <anon><anon>R1C1</anon><anon>R1C2</anon></anon>
  1761.       <anon><anon>R2C1</anon><anon>R2C2</anon></anon>
  1762.     </opt>
  1763.  
  1764.     [
  1765.       [ 'Col 1', 'Col 2' ],
  1766.       [ 'R1C1', 'R1C2' ],
  1767.       [ 'R2C1', 'R2C2' ]
  1768.     ]
  1769.  
  1770. Elements which only contain text content will simply be represented as a
  1771. scalar.  Where an element has both attributes and text content, the element
  1772. will be represented as a hashref with the text content in the 'content' key:
  1773.  
  1774.   <opt>
  1775.     <one>first</one>
  1776.     <two attr="value">second</two>
  1777.   </opt>
  1778.  
  1779.   {
  1780.     'one' => 'first',
  1781.     'two' => { 'attr' => 'value', 'content' => 'second' }
  1782.   }
  1783.  
  1784. Mixed content (elements which contain both text content and nested elements)
  1785. will be not be represented in a useful way - element order and significant
  1786. whitespace will be lost.  If you need to work with mixed content, then
  1787. XML::Simple is not the right tool for your job - check out the next section.
  1788.  
  1789. =head1 WHERE TO FROM HERE?
  1790.  
  1791. B<XML::Simple> is by nature very simple.  
  1792.  
  1793. =over 4
  1794.  
  1795. =item *
  1796.  
  1797. The parsing process liberally disposes of 'surplus' whitespace - some 
  1798. applications will be sensitive to this.
  1799.  
  1800. =item *
  1801.  
  1802. Slurping data into a hash will implicitly discard information about attribute
  1803. order.  Normally this would not be a problem because any items for which order
  1804. is important would typically be encoded as elements rather than attributes.
  1805. However B<XML::Simple>'s aggressive slurping and folding algorithms can
  1806. defeat even these techniques.
  1807.  
  1808. =item *
  1809.  
  1810. The API offers little control over the output of C<XMLout()>.  In particular,
  1811. it is not especially likely that feeding the output from C<XMLin()> into
  1812. C<XMLout()> will reproduce the original XML (although passing the output from
  1813. C<XMLout()> into C<XMLin()> should reproduce the original data structure).
  1814.  
  1815. =item *
  1816.  
  1817. C<XMLout()> cannot produce well formed HTML unless you feed it with care - hash
  1818. keys must conform to XML element naming rules and undefined values should be
  1819. avoided.
  1820.  
  1821. =item *
  1822.  
  1823. C<XMLout()> does not currently support encodings (although it shouldn't stand
  1824. in your way if you feed it encoded data).
  1825.  
  1826. =item *
  1827.  
  1828. If you're attempting to get the output from C<XMLout()> to conform to a
  1829. specific DTD, you're almost certainly using the wrong tool for the job.
  1830.  
  1831. =back
  1832.  
  1833. If any of these points are a problem for you, then B<XML::Simple> is probably
  1834. not the right module for your application.  The following section is intended
  1835. to give pointers which might help you select a more powerful tool - it's a bit
  1836. sketchy right now but submissions are welcome.
  1837.  
  1838. =over 4
  1839.  
  1840. =item XML::Parser
  1841.  
  1842. B<XML::Simple> is built on top of B<XML::Parser>, so if you have B<XML::Simple>
  1843. working you already have B<XML::Parser> installed.  This is a comprehensive,
  1844. fast, industrial strength (non-validating) parsing tool built on top of James
  1845. Clark's 'expat' library.  It does support converting XML into a Perl tree
  1846. structure (with full support for mixed content) but for arbritrarily large
  1847. documents you're probably better off defining handler routines for
  1848. B<XML::Parser> to call as each element is parsed.  The distribution includes a
  1849. number of sample applications.
  1850.  
  1851. =item XML::DOM
  1852.  
  1853. The data structure returned by B<XML::Simple> was designed for convenience
  1854. rather than standards compliance.  B<XML::DOM> is a parser built on top of
  1855. B<XML::Parser>, which returns a 'Document' object conforming to the API of the
  1856. Document Object Model as described at http://www.w3.org/TR/REC-DOM-Level-1 .
  1857. This Document object can then be examined, modified and written back out to a
  1858. file or converted to a string. 
  1859.  
  1860. =item XML::Grove
  1861.  
  1862. Compliance with the Document Object Model might be particularly useful when
  1863. porting code to or from another language.  However, if you're looking for a
  1864. simpler, 'perlish' object interface, take a look at B<XML::Grove>.
  1865.  
  1866. =item XML::Twig
  1867.  
  1868. XML::Twig offers a tree-oriented interface to a document while still allowing
  1869. the processing of documents of any size. It allows processing chunks of
  1870. documents in tree-mode which can then be flushed or purged from the memory.
  1871. The XML::Twig page is at http://standards.ieee.org/resources/spasystem/twig/
  1872.  
  1873. =item libxml-perl
  1874.  
  1875. B<libxml-perl> is a collection of Perl modules, scripts, and documents for
  1876. working with XML in Perl. The distribution includes PerlSAX - a Perl
  1877. implementation of the SAX API.  It also include B<XML::PatAct> modules for
  1878. processing XML by defining patterns and associating them with actions.  For more
  1879. details see http://bitsko.slc.ut.us/libxml-perl/ .
  1880.  
  1881. =item XML::PYX
  1882.  
  1883. B<XML::PYX> allows you to apply Unix command pipelines (using grep, sed etc) to
  1884. filter or transform XML files.  Ideally suited for tasks such as extracting all
  1885. text content or stripping out all occurrences of a particular tag without
  1886. having to write a Perl script at all.  It can also be used for transforming
  1887. HTML to XHTML.
  1888.  
  1889. =item XML::RAX
  1890.  
  1891. If you wish to process XML files containing a series of 'records', B<XML::RAX>
  1892. provides a simple purpose-designed interface.  If it still hasn't made it to
  1893. CPAN, try: http://www.dancentury.com/robh/
  1894.  
  1895. =item XML::Writer
  1896.  
  1897. B<XML::Writer> is a helper module for Perl programs that write XML documents.
  1898.  
  1899. =item XML::Dumper
  1900.  
  1901. B<XML::Dumper> dumps Perl data to a structured XML format. B<XML::Dumper> can
  1902. also read XML data that was previously dumped by the module and convert it back
  1903. to Perl. 
  1904.  
  1905. =back
  1906.  
  1907. Don't forget to check out the Perl XML FAQ at:
  1908. http://www.perlxml.com/faq/perl-xml-faq.html
  1909.  
  1910.  
  1911. =head1 STATUS
  1912.  
  1913. This version (1.08) is the current stable version.
  1914.  
  1915. =head1 SEE ALSO
  1916.  
  1917. B<XML::Simple> requires B<XML::Parser> and B<File::Spec>.  The optional caching
  1918. functions require B<Storable>.
  1919.  
  1920. =head1 COPYRIGHT 
  1921.  
  1922. Copyright 1999-2001 Grant McLean E<lt>grantm@cpan.orgE<gt>
  1923.  
  1924. This library is free software; you can redistribute it and/or modify it
  1925. under the same terms as Perl itself. 
  1926.  
  1927. =cut
  1928.  
  1929.  
  1930.